perm filename CAN.VLI[VLI,LSP] blob
sn#381954 filedate 1978-09-08 generic text, type C, neo UTF8
COMMENT ⊗ VALID 00004 PAGES
C REC PAGE DESCRIPTION
C00001 00001
C00002 00002 (de meta-match (pat dat alist alist2 tal)
C00027 00003 (de suivant (a1 a2)
C00040 00004 (de meta-prep (x alist m)
C00048 ENDMK
C⊗;
;(de meta-match (pat dat alist alist2 tal)
(meta-m1 pat dat alist alist2 tal));
(de -long () (meta-match dat pat alist2 alist (not tal)))
(de compl (l m)
(mapc '(1 2 3 4)
'(lambda (x) (cond ((memq x l))
(t (setq m (nconc1 m x)))))) m)
(de corrige (al m)
(list (corr1 (car al) m) (corr1 (cadr al) m)))
(de corr1 (al m n)
(mapc al '(lambda (x)
(setq n (nconc1 n (cons (car x) (meta-prep (cdr x) m)))))) n)
(DE %W% (AL V)
(IF V (%W%1 AL V) AL))
(de %w%1 (al v)
(cond ((null al) (and v (list (list '%w% v))))
((eq (caar al) '%w%)
(cons (cons '%w% (cons v (cdar al))) (cdr al)))
(t (cons (car al) (%w%1 (cdr al) v)))))
(de membre (x l p)
(cond ((null l) 'not)
((equal (car l) x) (nconc p (cdr l)))
(t (membre x (cdr l) (nconc1 p (car l))))))
(de meta-match (pat dat alist alist2 tal)
(mapct (meta-m1 pat dat alist alist2 tal)
'(lambda (m) (corrige m (append (car m) (cadr m))))))
(de meta-m1 (pat dat alist alist2 tal m n o p r RR aid aid1 aid2
aid3 aid4 aid5 aid6 ti ta to truc)
(cond ((atom pat)
(cond ((eq pat dat) (alist))
((atom dat) nil)
(t (meta-match dat pat alist2 alist (not tal)))))
((eq (car pat) 'rec)
((lambda (nv a)
(if a (meta-match nv dat (%w% alist (cons nv pat))
alist2 tal)
(meta-match nv dat alist (%w% alist2 (cons nv pat)) tal)))
(list '! '(1 2 3 4) (list (nbneuf) '(%nb%)))
(assq '%w% alist)))
((eq (car dat) 'rec) (-long))
((eq (car pat) '!)
(cond ((equal pat dat) (alist))
((memq (car dat) '(%et% %ou% %c%)) (-long))
((eq (car dat) '!)
((lambda (int)
(cond ((equal int (cadr dat))
(integre pat dat 'alist))
((equal int (cadr pat))
(integre dat pat 'alist2))
(int (integre pat
(setq m (clam int
(list (nbneuf) '(%nb%))))
'alist)
(integre dat m 'alist2)) ))
(int (cadr pat) (cadr dat))))
((trouve pat dat) nil)
(t ((lambda (x)
((lambda (int)
(if int (if (equal int x) (integre pat dat 'alist)
; x = (3 4) forcement et int = (3) ou (4) ;
((lambda (patairn)
((lambda (lal)
(meta-match patairn (NON-NUL DAT 'ALIST2)
(car lal) (cadr lal)))
(car (meta-match pat patairn alist alist2))))
(clam int [(nbneuf) '(%nb%)])))))
(int (cadr pat) x)))
(nature dat)))))
((eq (car pat) '%et%) ; ;)
((eq (car pat) '%ou%)
(mapc (cdr pat) '(lambda (x)
(cond ((setq m (meta-match x dat alist alist2 tal))
(setq aid (nconc aid m))) ))) aid)
((eq (car pat) '%c%)
(cond ((eq (car dat) '%c%)
(meta-match (caddr pat) (caddr dat) alist alist2 tal))
((setq m (meta-match (cadr pat) dat))
(mapc m '(lambda (m)
((lambda (ali1 ali2 ali)
(setq ali (append ali1 ali2))
(cond ((null ali) (LESCAPE))
((and (null (cdr ali))(null (cddar ali)))
; ali = ((x ((%nb% *1*) *2*))) ;
(setq n (cdr (cadar ali)))
; n = (*2*) ;
(cond ((seqvar (cadar ali))
(if n (setq p t)
(integre (list t t (list (caar ali)
(car (cadar ali))))
(cons (nvarnf '(%seq%)))
(setq r (if ali1 'alist 'alist2)))))
; cas ou une variable de sequence est affectee. etudier les cas ou la
complementation peut etre construite: ex: ¬(e1/p(e1) e2/p(e2)...en/p(en))
<=> (e1/p(e1) e2/p(e2) ... ei/p(ei) e/¬p(e) ?x) et n=i+longueur de ?x ;
(t (integre (list t t (list (caar ali)
(car (cadar ali))))
(%c% n (1varnf '(%nb%)))
(setq r (if ali1 'alist 'alist2))))))
; ceci est faux. prevoir le cas ou la negation touche non pas un
element mais une sequence. Argument pour representer la negation hors du
filtre. ;
(t ;pareil pour ici. cas ou plusieurs variables
sont affectees. ; (setq p t)))
(setq o (nconc o (if p
(meta-match (caddr pat) dat (%w% alist pat)
alist2 tal)
(meta-match (meta-prep (caddr pat) r)
(meta-prep dat r) alist alist2 tal)))))
(squel (car m) (list (cadr pat) dat))
(squel (cadr m) (list (cadr pat) dat))))) o)
; si sur que alist contient les vars de pat et alist2 dat, changer les
(list (cadr pat) dat) en respectivement (cadr pat) et dat ;
(t (meta-match (caddr pat) dat alist alist2 tal))))
((eq (car dat) '!) (-long))
((memq (car pat) '(%nb% %seq%))
(cond ((memq (car dat) '(%nb% %seq%))
(setq %kk% t
m (nb-mmatch (cdr pat) (cdr dat))
%kk% nil) m)))
((and dat (atom dat)) nil)
((memq (car dat) '(%c% %et% %ou% %nb%)) (-long))
((eq (car (setq aid (nextl pat))) '?)
(cond ((equal aid (car dat))
(meta-match pat (cdr dat) alist alist2 tal))
((assq (caaddr aid) %ib%) nil)
((null dat)
(IF (EQ (CADR AID) 'NNIL) NIL
(integre aid nil 'alist)
(meta-match (meta-prep pat alist) nil alist alist2 tal)))
(pat
(COND ((AND (NULL (CDR DAT)) (EQ (CAAR DAT) '?))
(SETQ PAT (CONS AID PAT)) (-LONG))
((EQUAL AID (CAR (SETQ R (REVERSE DAT))))
(CIRCULAIRE AID PAT (REVERSE (CDR R))))
((and (memq (caar dat) '(? %l%))
(equal (car (setq r (reverse pat)))
(car dat)))
(circulaire (nextl dat) (reverse (cdr r))
dat))
(T
(escape out (while dat
(suivant)
(IF (SETQ RR (CAR (META-MATCH (CONS AID) AID2 ALIST
(IF O (CONS O ALIST2) ALIST2) TAL)))
(let ((alist (CAR RR))(alist2 (CADR RR))(xmm))
(setq xmm (append alist alist2)
alist (corr1 alist xmm)
n (nconc n
((if %kk% 'nb-mmatch 'meta-match)
(meta-prep pat (setq m (cons o alist)))
(meta-prep dat m)
(if %kk% nil alist)
(corr1 alist2 xmm) tal))) )))) n)))
((neq (setq m (membre aid dat)) 'not)
(meta-match m nil alist alist2 (not tal)))
((trouve aid dat) nil)
((AND (EQ (CADR AID) 'NNIL) (MEMQ (CAAR DAT) '(? %L%)))
(INTEGRE AID (NON-NUL DAT 'ALIST2) 'ALIST))
(t (integre aid dat 'alist)) ))
((eq (car aid) '%l%)
(cond ((equal aid (car dat))
(meta-match pat (cdr dat) alist alist2 tal))
((null dat)
((lambda (x xx)
(IFN X NIL
(setq xx (append (car x) (cadr x)))
(meta-match pat nil (car x) (cadr x) tal)))
(CAR (meta-match (cadr (caddr aid)) '(%nb%)
alist alist2 tal))))
(pat
(cond ((and (null (cdr dat))(eq (caar dat) '?))
(setq pat (cons aid pat)) (-long))
((equal aid (car (setq r (reverse dat))))
(circulaire aid pat (reverse (cdr r))))
((and (memq (caar dat) '(? %l%))
(equal (car (setq r (reverse pat)))
(car dat)))
(circulaire (nextl dat) (reverse (cdr r))
dat))
(t (escape out (while dat
(suivant)
; si %kk% = t ici, faire le cas ou PAT et DAT sont des nombres, en
comparant avec ?. Il faut corr1 alist et alist2 et peut-etre o
(a voir). ;
(cond ((setq m (car (meta-match (cons aid) aid2
alist (cons o alist2) tal)))
((lambda (alist alist2 m)
(setq n (nconc n
(meta-match
(meta-prep pat m)
(meta-prep dat m) alist alist2 tal))))
(car m) (cadr m) (append (car m) (cadr m)))
)))) n)))
((atom dat) nil)
((trouve aid dat) nil)
((eq (caar dat) '?) (setq pat (cons aid)) (-long))
((eq (caar dat) '%l%)
(cond ((cdr Dat) (setq pat (cons aid)) (-long))
(t
((lambda (patt1 patt2 alph bet i j)
((lambda (x y)
(cond ((and (numbp x) (numbp y))
(cond ((eq x y)
((lambda (z n)
(and z
((lambda (a al1 al2)
(setq %ib% (cons (cons i
(meta-prep (subst i j (cdr alph)) a)) %ib%))
(setq n
(escape whe
(meta-match (meta-prep patt1 a)
(meta-prep (subst i j patt2) a)
al1 al2 tal)))
(nextl %ib%)
(if (or (null n) (eq n t))
(append
(if (eq n t)
((lambda (ma)
(meta-match (indice patt1) (indice patt2)
(car ma) (cadr ma) tal))
(car (meta-match '(%nb% 1) bet al1 al2 tal))))
(meta-match nil bet al1 al2 tal))
n))
(append (car z) (cadr z))
(append (car z) alist)
(append (cadr z) alist2) )))
(car (meta-match alph bet))))
(t
((lambda (z v1 v2 emp)
(mapc (meta-match
(list alph (cons '%nb% (repete (cadr z) v2)))
(list (cons '%nb% (repete (car z) v1)) bet)
alist alist2 tal)
'(lambda (x xx)
(setq xx (append (car x) (cadr x)))
(setq emp (nconc emp (meta-match
(chgvisu patt1 i (car z) v1 (cdddr aid))
(chgvisu patt2 j (cadr z) v2 (cdddr m))
(car x) (cadr x) tal) )) ))
emp)
(ppcm x y)
(cons (varnam (nbneuf)))
(cons (varnam (nbneuf))) ))))
(t '%w%)))
(plong patt1) (plong patt2)))
(cadr aid)
(cadr (setq m (nextl dat)))
(cadr (caddr aid))
(cadr (caddr m))
(caaddr aid)
(caaddr m)))))
(t ((lambda (y k k2 m n x xx l)
(cond ((zerop (car y)) ;; )
(t (setq k 0 l dat)
(while (and l (not (memq (caar l) '(? %l%))))
(setq m (nconc1 m (nextl l))
k (add1 k)))
(if (and (eq (caar l) '%l%)
(lt k y)
(numbp (setq n (plong (cadar l))))
(le (setq k2 (differ y k)) n))
((lambda (v p i)
(setq x (car (meta-match
(cdadr (caddar l)) (list v 1)
alist alist2 tal))
xx
(append (setq alist (car x))
(setq alist2 (cadr x)))
dat
(append (append m
(jusq k2 (indice (car l) nil)))
(cons (turn (jusq k2 p)(nth (add1 k2) p))
(append (nth (add1 k2)
(indice (car l) (cons v)))
(cdr l))))) )
(varnam (nbneuf))
(cadar l)
(car (caddar l))))
((lambda (v i)
((lambda (x)
(meta-match
(nconc1 (indice aid nil)
(mcons '%l% (meta-prep (substit
(cadr aid) (varnam i)
(list 1 (varnam i)))
(append (car x) (cadr x)))
[i ['%nb% v]] (cdddr aid)))
dat (car x) (cadr x) tal))
(car (meta-match (cdadr (caddr aid))
(list 1 v) alist alist2 tal))))
(varnam (nbneuf)) (caaddr aid) ))))
(plong (cadr aid))) )))
((null dat) nil)
((memq (caar dat) '(? %l%)) (setq pat (cons aid pat)) (-long))
((eq (car aid) 'rec)
((lambda (mm) (meta-match pat dat (car mm) (cadr mm) tal))
(car (meta-match aid (nextl dat) alist alist2 tal))))
(t (mapc (meta-match aid (nextl dat) alist alist2 tal)
'(lambda (x xx)
(setq xx (append (car x) (cadr x)))
(setq m (append m (meta-match (meta-prep pat xx)
(meta-prep dat xx) (car x) (cadr x) tal)))))
m)))
(de suivant (a1 a2)
(cond ((null ti) (setq ti t) (suiv))
((null dat) (out))
((equal (car dat) aid) (out))
((eq ta 2) (reforge) (suivant))
(ta (reforge)
(cond ((and aid5 (equal (cadr dat) (car aid5)))
(setq o nil TA NIL) (suivant))
((EQ TA 3) (SETQ TA NIL) (SUIV))
(t (nextl dat) (suiv))))
((eq (caar dat) '?)
(setq x (cadr (caddar dat)))
(if (memq (caadr dat) '(? %l%))
(mer (cons (setq a1 (varnf x))
(setq a2 (IF %KK% (LIST 1 (varnf x))
(CONS (NVARNF X)))))
'append (IF %KK% T 3))
(mer (list (setq a1 (varnf x)) (setq a2 (varnf x)))
'cons 2)))
((eq (caar dat) '%l%)
((lambda (v1 v2 p i b)
(cond ((car to)
((lambda (x xx)
(store-alist)
(setq dat (%l%ilot)))
(car (meta-match b (list '%nb% 1 v2)
alist alist2 (not tal))))
(suivant))
((memq (caadr dat) '(? %l%))
(finseg%l% (%l%ilot (cons v1) (list v1 1))
(list '%nb% v1 1 v2)
(nextl dat))
(setq to (cons nil to)) (suiv))
(t (finseg%l%
(cons (partvisu p (cons [i ['(%seq%) (varnam i) v1]])
i v2 dat)
(cdr dat))
['%nb% v1 v2] (nextl dat))
(setq to (cons t to)) )))
(varnam (nbneuf))
(varnam (nbneuf))
(cadar dat) (car (caddar dat)) (cadr (caddar dat)) ))
((trouve aid (car dat)) (out))
((and aid5 (equal (cadr dat) (car aid5)))
(ici)
(if (nextl to) (suivant) (suiv)) )
(t (setq aid2 (nconc1 aid2 (nextl dat))) (suiv))))
(de finseg%l% (right sect cardat)
(setq aid3 (cons aid2 aid3)
truc (cons cardat truc))
((lambda (x xx)
(setq r (cons (cons alist alist2) r))
(store-alist)
(setq aid2 (append aid2 (cons (partvisu p xx i v1 truc)))
dat (meta-prep right xx)))
(car (meta-match b sect alist alist2 (not tal)))) )
(de reforge ()
(setq o nil aid2 aid6 ta (IF (EQ TA 3) 3 NIL)
dat (cdr dat) aid2 (nconc1 aid2 truc)))
(de mer (coupe f x)
((lambda (x) (integre (car dat) coupe 'o))
(cadr (caddar dat)))
(setq o (car o) truc (nextl dat) aid6 aid2 ta x dat (f a2 dat)
aid2 (append aid2 (cons a1))) )
(de 1varnf (x) ['! '(1 2 3 4) (list (nbneuf) x)])
(de %l%ilot (rang coupe)
(append (indice (car dat) rang)
(cons (car (setq aid5
(cons (partvisu p
(cons [i (mcons '(%seq%) (varnam i) coupe)])
i v2 dat)
aid5)))
(car (setq aid4 (cons (cdr dat) aid4))) )))
(de alist ()
(list (if tal [alist2 alist] [alist alist2])))
(de varnf (x) ['? 'p [(nbneuf) x]])
(de suiv () (if (memq (caar dat) '(? %l%)) (suivant)))
(de partvisu (p xx i vi last)
(mcons '%l% (meta-prep p xx) [i ['%nb% vi]] (cdddar last)))
(de chgvisu (patti i zi vi last ;; m)
(cons (mcons '%l%
(meta-prep (extend (substit patti (varnam i)
(setq m (repete zi (cons (varnam i)))))
patti i m zi 1) xx)
(list i (cons '%nb% (meta-prep vi xx))) last)))
(setq %kk% nil)
(de plong (l k)
(setq k 0)
(escape out (mapc l '(lambda (x)
(if (memq (car x) '(? %l%)) (out) (incr k)))) k))
(de nb-mmatch (l m rm aux)
(if l ((lambda (mb)
(cond ((eq mb 'not) (nb-mmatch (cdr l) m (NCONC1 RM (CAR L))))
(t (nb-mmatch (cdr l) mb rm))))
(membre (car l) m))
(meta-match rm m alist alist2 tal)))
(de repete (nb x)
(cond ((gt nb 1) (repete (sub1 nb) (cons (car x) x)))
((zerop nb) nil)
(t x)))
(de trouve (x y)
(cond ((equal x y))
((atom y) nil)
((eq (car y) '%c%) (trouve x (caddr y)))
(t (or (trouve x (nextl y)) (trouve x y)))))
(de nature (x ;; m)
(cond ((atom x)
(cond ((numbp x) '(1))
((null x) '(3))
(t '(2))))
((eq (car x) '%nb%) '(1))
((FMEMBER X DENATURES) '(4))
(t (while x
(if (eq (caar x) '?)
(if (eq (cadar x) 'nnil) (lescape '(4)))
(if (eq (caar x) '%l%)
(if (eq (nature (cdadr (caddar x))) '(4))
(lescape '(4)))))
(nextl x)) '(3 4))))
(DE FMEMBER (X DEN) (MEMBER X DEN) ;a compliquer plus tard;)
(DE NON-NUL (X ALIST ;; M)
(COND ((CDR X) (%W% ALIST2 ['%C% NIL X])
(SETQ DENATURES (CONS X DENATURES))
X)
((EQ (CAAR X) '?)
;verifier que pas contenue dans denatures;
(INTEGRE (CAR X) (SETQ M ['? 'NNIL [(NBNEUF)
(CADR (CADDAR X))]]) ALIST)
M)
(T ; X = ((%l% ...)). verifier aussi.;
(SETQ X (CAR X))
[(NEXTL X) (NEXTL X)
[(CAAR X)
(CONS '%NB% (NON-NUL (CDADAR X)))]])))
(SETQ DENATURES NIL)
(DE CIRCULAIRE (X Y Z)
(SETQ AMATCHER (CONS (LIST X Y) AMATCHER))
(PRINT 'CIRCULAIRE X Y Z) NIL)
(SETQ AMATCHER NIL)
(de int (x y ;; m)
(mapc x '(lambda (x)
(if (memq x y) (setq m (nconc1 m x))))) m)
(de extend (pat pa ind rind nb1 nb2)
(if (eq nb1 nb2) pat
(extend (append pat (meta-prep pa (cons (cons ind
(append rind (repete nb2 '(1))) )) ))
pa ind rind nb1 (add1 nb2))))
(de store-alist ()
(setq alist (car x) alist2 (cadr x) xx (append (car x) (cadr x))))
(de ici ()
((lambda (aa) (setq alist (nextl aa) alist2 aa)) (nextl r))
(nextl aid5)
(setq dat (nextl aid4) aid2 (nconc1 (nextl aid3) (nextl truc))))
(de jusq (n l) (reverse (cdr (nth (differ (length l) n) (reverse l)))))
(de ppcm (nb1 nb2)
(if (gt nb1 nb2) (ppcm1 nb1 nb2 0 0)
((lambda (x) [(cadr x) (car x)])
(ppcm1 nb2 nb1 0 0))))
(de ppcm1 (n1 n2 ;; m1 m2)
((lambda (n k1 k2)
(escape out
(while (neq m1 n)
(setq k2 1 k1 (add1 k1) m1 (times n1 k1))
(while (lt m2 m1)
(setq k2 (add1 k2) m2 (times n2 k2)))
(and (eq m2 m1) (out)) ))
[k1 k2])
(times n1 n2) 0))
(de integre (x y z fi)
(setq fi (caddr x))
; (set z (corr1 (car z) (cons (cons (car fi) (cons (cadr fi) y)))));
;faire une fct qui propage une seule affectation;
(set z (integr1 (car fi)
(escape out (if %ib%
(mapc %ib% '(lambda (i) (f-ind (car i) (cdr i) (cadr fi)))))
(cons (cadr fi) y))
(eval z)))
(alist))
(de integr1 (x y z)
(cond ((null z) [[x y]])
((eq (caar z) x) (cons (cons x (cons y (cdar z))) (cdr z)))
(t (cons (nextl z) (integr1 x y z)))))
(de f-ind (a c d)
(cond ((trouve (varnam a) d)
(out (mcons a (cdr d) c y)))
;s'occuper ici du cas: PAT = X F(I) , DAT = H (X G(I));
(t (uniformise dat))))
(de uniformise (x)
(cond ((atom x) x)
((eq x (varnam a)) (whe t))
((memq (car x) '(! ?))
((lambda (v) (integre x v (if (eq z 'alist) 'alist2 'alist))
v)
[(car x) (cadr x) [(nbneuf) (cons (caadr (caddr x)))]]))
(t (mapcar x 'uniformise))))
(de nvarnf (x)
['? 'nnil [(nbneuf) x]])
(de plong2 (l k)
(while l
(or (memq (caar l) '(%l% ?)) (incr k))
(nextl l)) k)
(de meta-prep (x alist m)
(cond ((atom x) x)
((eq (car x) '!)
((lambda (v i)
(escape out
(mapc (cdr v) '(lambda (z)
(cond ((atom (car z))
(cond (%ib
((lambda (seg1 seg2)
(if (eqseg seg1 seg2) (out (cdddr z))))
((lambda (b0 b1)
(mapc %ib '(lambda (y)
(setq b1 (substit b1 (car y) (cdr y))
b0 (substit b0 (car y)))))
[b1 b0])
(cdr i) (cdr i))
[(substit (cadr z) (varnam (car z)) (caddr z))
(substit (cadr z) (varnam (car z)))] ))))
((equal (cdr i) (cdar z)) (out (cdr z))) )))
['! (cadr x) [(caaddr x) i]] ))
(assq (caaddr x) alist)
(meta-prep (cadr (caddr x)) alist)))
((eq (car x) '%c%)
(let ((y (meta-prep (cadr x) alist))
(z (meta-prep (caddr x) alist)))
(cond ((equal x y) (hors))
((meta-match y z) ['%c% y z])
(t z))))
((eq (caar x) '?)
(let ((n (meta-prep (cons '! (cdar x)) alist)))
(if (eq (car n) '!) (cons (car x)
(meta-prep (cdr x) alist))
(append n (meta-prep (cdr x) alist)))))
((eq (caar x) '%l%)
((lambda (i nb)
(cond ((cdr nb)
(meta-prep (append (cut (nextl x) nb (varnam i)) x)
alist))
((eq (car nb) 1)
(meta-prep (append (indice (nextl x)) x) alist))
(nb (cons (mcons
'%l%
((lambda (%ib) (meta-prep (cadar x) alist))
((lambda (x)
(cons (cons (varnam i) (if x (cdr x) nb)) %ib))
(assq (car (caddar nb)) %ib)))
[i (cons '%nb% nb)]
(cdddar x))
(meta-prep (cdr x) alist)))
(t (meta-prep (cdr x) alist))))
(car (caddar x))
(meta-prep (cdadr (caddar x)) alist)))
(t (cons (meta-prep (car x) alist)
(meta-prep (cdr x) alist)))))
(de indice (exp a) (substit (cadr exp)(varnam (caaddr exp)) a))
(de cut (exp nb i ;; y lx)
(mapc nb '(lambda (x ;; vi)
(setq vi (append lx (cons i))
y (nconc1 y
(mcons '%l% (substit (cadr exp) i vi)
[(caaddr exp) ['%nb% x]]
(substit (cdddr exp) i vi)))
lx (nconc1 lx x)) ))
(if (cdddr exp) (reverse y) y))
(de substit (l e1 e2)
(cond ((atom l) l)
((equal (car l) e1) (append e2 (substit (cdr l) e1 e2)))
(t (cons (substit (nextl l) e1 e2) (substit l e1 e2)))))
(de eqseg (c d)
(cond ((equal (car c) (car d)) (equal (cadr c) (cadr d)))
((equal (car c) (cadr d)) (equal (cadr c) (car d)))))
(setq %sigs% '(%et% %ou% %nb% %c% ! rec) k nil %ib nil %ib% nil nbneuf 10)
(de nbneuf () (incr nbneuf))
(de varnam (nam) (list '? 'p (list nam '(%seq%))))
(de squel (alist pat)
(cond ((atom pat) nil)
((memq (car pat) '(! ?))
((lambda (asq)
(if asq (cons asq)))
(assq (caaddr pat) alist)))
(t (append (squel alist (nextl pat)) (squel alist pat)))))
(de seqvar (x) (eq (if (atom (car x)) (caadr x) (caar x)) '%seq%))
(de fusion (alist1 alist2 pat ;; m)
(cond ((atom pat) alist1)
((memq (car pat) '(! ?))
((lambda (nom)
(if (setq m (assq nom alist2))
(if (assq nom alist1) alist1 (cons m alist1))
alist1))
(caaddr pat)))
(t (fusion (fusion alist1 alist2 (car pat)) alist2 (cdr pat)))))
(de clam (domain name)
(selectq domain
((3) nil)
((3 4) (cons (varnf '(%seq%))))
((4) (cons (nvarnf '(%seq%))))
(['! domain name])))
(de %c% (p1 p2)
;p1 filtre a complementer dans p2. Pour l'instant, p2 est
l'ensemble des elements LISP;
(if (null p1) ['%c% ['! '(1 2 4) [(nbneuf) '(%nb%)]] p2]
;etudier ici les possibilites de complementer un filtre dans
l'ensemble des elements LISP;
['%c% p1 p2]))
(setq l nil)
(status 18 '! '(lambda (x) (setq x (read))
(if (atom x) ['! '(1 2 3 4) (list x '(%nb%))]
(cons '! x))))
(status 18 '? '(lambda (x) (setq x (read))
(if (atom x) (varnam x) (cons '? x))))